home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / pvt12.zip / PVT.BAS < prev    next >
BASIC Source File  |  1990-11-22  |  3KB  |  129 lines
  1. DECLARE SUB SaveFile ()
  2. DECLARE SUB GetPassword ()
  3. DECLARE SUB LoadFile ()
  4. DECLARE SUB Crypt (PWord$)
  5. DEFINT A-Z
  6. DIM SHARED Buf$(5000), PWord$, LineCnt, FileName$
  7.  
  8. CLS
  9. PRINT "PVT Private File scrambler v1.2 (c) 1990 Brent Ashley"
  10. PRINT : PRINT "      Please Enter Private Password: [xxxx]"
  11. GetPassword
  12. IF PWord$ = "    " THEN
  13.   PRINT "PVT Aborted."
  14.   END
  15. END IF
  16. LoadFile
  17. Crypt PWord$
  18. SaveFile
  19. PRINT "...Done": PRINT
  20. END
  21.  
  22. ErrorHandler:
  23.   BEEP
  24.   COLOR 7, 0: CLS
  25.   SELECT CASE ERR
  26.     CASE 14
  27.       PRINT "File too big (40k max)"
  28.     CASE 52
  29.       PRINT "Bad File Name or Number"
  30.     CASE 71
  31.       PRINT "Disk Not Ready"
  32.     CASE 76
  33.       PRINT "Path Not Found"
  34.     CASE ELSE
  35.       PRINT "Error #"; ERR
  36.       ERROR ERR
  37.   END SELECT
  38.   END
  39.  
  40. SUB Crypt (PWord$)
  41.   STATIC i, j
  42.   PRINT
  43.   PRINT "Scrambling..."
  44.   ' calculate Xor value
  45.   xnum = 0
  46.   FOR i = 1 TO 4
  47.     xnum = xnum + (ASC(MID$(PWord$, i, 1)) * i)
  48.   NEXT
  49.   xnum = xnum MOD 256
  50.   ' crypt buffer
  51.   FOR i = 0 TO LineCnt
  52.     FOR j = 1 TO LEN(Buf$(i))
  53.       IF j MOD 2 THEN ' even/odd
  54.         MID$(Buf$(i), j, 1) = CHR$(ASC(MID$(Buf$(i), j, 1)) XOR xnum)
  55.       ELSE
  56.         MID$(Buf$(i), j, 1) = CHR$(ASC(MID$(Buf$(i), j, 1)) XOR (255 - xnum))
  57.       END IF
  58.     NEXT
  59.   NEXT
  60. END SUB
  61.  
  62. SUB GetPassword
  63.   PWord$ = "    "
  64.   Posn = 1
  65.   DO
  66.     LOCATE 3, 38 + Posn, 1
  67.     PKey$ = ""
  68.     DO
  69.       PKey$ = UCASE$(INKEY$)
  70.     LOOP WHILE PKey$ = ""
  71.     SELECT CASE PKey$
  72.       CASE "0" TO "9", "A" TO "Z", " "
  73.         PRINT " ";
  74.         MID$(PWord$, Posn, 1) = PKey$
  75.         Posn = Posn + 1
  76.         IF Posn > 4 THEN EXIT DO
  77.       CASE CHR$(8), CHR$(0) + "K"
  78.         IF Posn > 1 THEN
  79.           Posn = Posn - 1
  80.         ELSE
  81.           BEEP
  82.         END IF
  83.       CASE CHR$(27)
  84.         PWord$ = "    "
  85.         EXIT DO
  86.       CASE ELSE
  87.         BEEP
  88.     END SELECT
  89.   LOOP
  90.   PRINT : PRINT
  91. END SUB
  92.  
  93. SUB LoadFile
  94.   FileName$ = COMMAND$
  95.   PRINT "Loading file...";
  96.   ON ERROR GOTO ErrorHandler
  97.   OPEN FileName$ FOR INPUT AS 1
  98.   LineCnt = 0
  99.   DO WHILE NOT EOF(1)
  100.     LINE INPUT #1, Buf$(LineCnt)
  101.     IF Buf$(LineCnt) = CHR$(12) THEN Buf$(LineCnt) = " "
  102.     LineCnt = LineCnt + 1
  103.   LOOP
  104.   CLOSE 1
  105.   ON ERROR GOTO 0
  106. END SUB
  107.  
  108. SUB SaveFile
  109.   dotpos = INSTR(FileName$, ".")
  110.   IF dotpos THEN
  111.     BeforeDot$ = LEFT$(FileName$, dotpos - 1)
  112.   ELSE
  113.     BeforeDot$ = RTRIM$(FileName$)
  114.   END IF
  115.   OutFile$ = BeforeDot$ + ".PVT"
  116.   PRINT "Saving "; OutFile$; "..."
  117.   ON ERROR GOTO ErrorHandler
  118.   OPEN OutFile$ FOR BINARY AS 1
  119.   tmp$ = "{ePbVaT}" + CHR$(13) + CHR$(10)
  120.   PUT #1, , tmp$
  121.   FOR i = 0 TO LineCnt
  122.     Length% = LEN(Buf$(i))
  123.     PUT #1, , Length%
  124.     PUT #1, , Buf$(i)
  125.   NEXT
  126.   CLOSE 1
  127. END SUB
  128.  
  129.